home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
lang_oth
/
forchek1
/
forchek.c
< prev
next >
Wrap
C/C++ Source or Header
|
1991-11-05
|
23KB
|
870 lines
/* forchek.c:
Main program for Fortran Syntax Checker.
Copyright (C) 1991 by Robert K. Moniot.
This program is free software. Permission is granted to
modify it and/or redistribute it, retaining this notice.
No guarantees accompany this software.
Top-level input/output is done here: opening and closing files,
and printing error, warning, and informational messages.
Shared functions defined:
print_a_line() Prints source code line.
yyerror() Error messages from yyparse and elsewhere.
syntax_error() Error messages with line and column num.
warning() Warning messages.
nonportable() Portability warnings.
wrapup() Look at cross references, etc.
*/
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#define MAIN
#include "forchek.h"
/* char *getenv(),*malloc(); */
char *getenv();
void* malloc(unsigned);
void exit();
PRIVATE void src_file_in(),
error_message(), error_summary(), get_env_options(),
make_env_name(), set_option(), list_options(), open_outfile(),
resource_summary(), wrapup();
PRIVATE int read_setting();
PRIVATE int project_file_input, /* true if input is from .prj file */
full_output; /* = (verbose || do_list | do_symtab) */
unsigned long intrins_clashes; /* count of intrinsic hashtable clashes */
#ifdef COUNT_REHASHES
extern unsigned long rehash_count; /* count of calls to rehash() */
#endif
/* Here we define the commandline options. Most options are boolean
switchopts, with "no" prefix to unset them. Others (called
settings) are numeric quantities, defined using "=num".
A third category (strsettings) are string quantities, eg filenames.
The argument "?" will cause list of options to be printed out.
For VMS, options can be prefixed with either "-" or "/",
but messages will use the canonical form. */
#ifdef OPTION_PREFIX_SLASH
#define OPT_PREFIX '/' /* Canonical VMS prefix for commandline options */
#else
#define OPT_PREFIX '-' /* Canonical Unix prefix for commandline options */
#endif
#define OPT_MATCH_LEN 3 /* Options are matched only in 1st 3 chars */
#define NUM_SWITCHES (sizeof(switchopt)/sizeof(switchopt[0]))
#define NUM_SETTINGS (sizeof(setting)/sizeof(setting[0]))
#define NUM_STRSETTINGS (sizeof(strsetting)/sizeof(strsetting[0]))
/* Option definitions:
New options can be added to lists by inserting definition
here using same syntax as others, and declaring the variable
(twice!) in forchek.h. No other changes needed.
*/
/* List of switches is defined first. Each entry gives the
name and the corresponding flag variable to be set
or cleared. See set_option() for processing of switches.
N.B. list_options() will suppress printing of any options
whose explanation starts with "debug" unless the -debug
switch was previously given.
*/
struct {
char *name;
int *switchflag;
char *explanation;
} switchopt[]={
{"declare", &decls_required, "list undeclared variables"},
{"division", &div_check, "catch possible div by 0"},
{"extern", &ext_def_check, "check if externals defined"},
{"f77", &f77_standard, "warn of nonstandard constructs"},
{"library", &library_mode, "treat next files as library"},
{"linebreak", &eol_is_space, "treat linebreaks as space"},
{"list", &do_list, "print program listing"},
{"portability", &port_check, "check portability"},
{"project", &make_project_file, "create project file"},
{"symtab", &do_symtab, "print symbol table info"},
{"sixchar", &sixclash, "catch nonunique names"},
{"usage", &usage_check, "check var set/used status"},
{"verbose", &verbose, "verbose output"},
/* {"version", &print_version_num, "print version number"},*/
{"debug", &debug_latest, "debug latest code"},
{"global", &debug_glob_symtab, "debug global symtab info"},
{"grammar", &debug_parser, "debug printout in parser"},
{"yydebug", &yydebug, "debug via yydebug"},
{"hashtable", &debug_hashtab, "debug printout of hashtable"},
{"local", &debug_loc_symtab, "debug local symtab info"},
{"resources", &show_resources, "debug info on resources"},
{"tokens", &debug_lexer, "debug printout in lexer"},
};
/* List of settings is defined here. Each entry gives
the name, the corresponding variable, and the range
of permitted values, followed by brief explanation.
See set_option() for processing. */
struct {
char *name;
int *setvalue;
int minlimit,maxlimit;
char *explanation;
} setting[]={
{"columns", &max_stmt_col, 1, MAXLINE, "max line length processed"},
{"common", &comcheck_strictness, 0, 3,"common check: 0=none, 3=strict"},
{"novice", &novice_level, 1, 5, "novice level: 1=green, 5=wizard"},
};
/* List of strsettings is defined here. Each entry gives
the name the corresponding string variable, and brief
explanation. See set_option() for processing. */
struct {
char *name;
char **strvalue;
char *explanation;
} strsetting[]={
{"output", &out_fname, "output file name"},
};
int must_open_outfile=FALSE; /* Flag set to TRUE when out=name given */
int
main(argc,argv)
int argc;
char *argv[];
{
int iarg;
int filecount=0,actioncount=0;
char *infile,*srcfile,*projfile;
list_fd = stdout;
project_fd = NULL;
error_count = 0;
warning_count = 0;
get_env_options();
init_keyhashtab(); /* Initialize tables */
intrins_clashes = init_intrins_hashtab();
init_globals();
init_symtab();
for(iarg=1; iarg < argc; iarg++) {
/* Process flags here */
if( argv[iarg][0] == '-'
#ifdef OPTION_PREFIX_SLASH
|| argv[iarg][0] == '/' /* Allow VMS /option form */
#endif
) {
set_option(argv[iarg]);
}
else { /* Process '?' and file arguments */
full_output = verbose || do_list || do_symtab;
if( must_open_outfile )
open_outfile(out_fname);
if(actioncount == 0) {
fprintf(list_fd,"%s%s%s",
full_output?"\n":"",
VERSION_NUMBER,
full_output?"\n":"");
}
++actioncount; /* Cause exit w/o reading stdin below */
if(strcmp(argv[iarg],"?") == 0) {
list_options();
}
else { /* Process files here */
++filecount;
srcfile = add_ext(argv[iarg],DEF_SRC_EXTENSION);
projfile = new_ext(argv[iarg],DEF_PROJ_EXTENSION);
/* Project file mode: open source for reading
and .prj file for writing. */
if(make_project_file) {
infile = srcfile;
if( has_extension(infile,DEF_PROJ_EXTENSION) ) {
fprintf(stderr,
"Input from %s disallowed in project mode\n",infile);
continue;
}
if( (input_fd = fopen(infile,"r")) == NULL ) {
fprintf(stderr,"Cannot open file %s\n",infile);
continue;
}
project_fd = fopen(projfile,"w");
project_file_input = FALSE;
}
else {
/* Non project file mode: if input file extension
given, use it. Otherwise read project file
if it exists else read source file. */
if( argv[iarg]==srcfile
|| (input_fd = fopen(projfile,"r")) == NULL) {
infile = srcfile;
if( (input_fd = fopen(infile,"r")) == NULL ) {
fprintf(stderr,"Cannot open file %s\n",infile);
continue;
}
project_file_input =
has_extension(infile,DEF_PROJ_EXTENSION);
}
else {
infile = projfile;
project_file_input = TRUE;
}
}
/* Always print input .f file name. If
verbose mode, print .prj file names too.
In verbose mode, add blank line
and after file name. */
if(verbose || !project_file_input)
fprintf(list_fd,"\nFile %s:%s",
infile,
full_output?"\n":""
);
/* In verbose mode, print .prj output
file name to stderr. Always print
error message if couldn't open it. */
if( make_project_file ) {
if(project_fd != NULL) {
if(verbose)
fprintf(stderr,
"\nProject file is %s\n",projfile);
}
else {
fprintf(stderr,
"\nCannot open %s for output\n",projfile);
}
}
if(project_file_input) {
proj_file_in(input_fd);
}
else {
src_file_in(infile);
}
(void) fclose(input_fd);
}
}
} /* end for-loop on argument list */
if(actioncount == 0) { /* No files given: read stdin */
full_output = verbose || do_list || do_symtab;
fprintf(list_fd,"%s%s%s",
full_output?"\n":"",
VERSION_NUMBER,
full_output?"\n":"");
if( must_open_outfile )
open_outfile(out_fname);
if(make_project_file) {
projfile = STDIN_PROJ_FILENAME;
if( (project_fd = fopen(projfile,"w")) == NULL) {
fprintf(stderr,
"\nCannot open %s for output\n",projfile);
}
else {
if(verbose)
fprintf(stderr,
"\nProject file is %s\n",projfile);
}
}
input_fd = stdin;
src_file_in("std_input");
}
wrapup();
fprintf(list_fd,"\n");
if(show_resources)
resource_summary();
exit(0);
return 0;/* make lint happy */
}
PRIVATE void
src_file_in(infile)
char *infile; /* input filename */
{
note_filename(infile);
init_scan();
init_parser();
(void) yyparse();
finish_scan();
if(make_project_file) {
proj_file_out(project_fd);
(void) fclose(project_fd);
}
error_summary(infile);
}
PRIVATE void
error_summary(fname) /* Print out count of errors in file */
char *fname;
{
FILE *fd = list_fd;
if(full_output)
fprintf(fd,"\n");
if(port_check && tab_count != 0) {
++warning_count;
fprintf(list_fd,
"\n Warning: file contains tabs. May not be portable.\n");
}
if(full_output || error_count != 0)
fprintf(fd,"\n %u syntax error%s detected in file %s",
error_count, error_count==1? "":"s",
fname);
if(warning_count != 0)
fprintf(fd,"\n %u warning%s issued in file %s",
warning_count, warning_count==1? "":"s",
fname);
if(full_output)
fprintf(fd,"\n");
error_count = 0;
warning_count = 0;
}
void
print_a_line(fd,line,num) /* Print source line with line number */
FILE *fd;
char *line;
unsigned num;
{
fprintf(fd,"\n %6u %s",num,line);
}
void
yyerror(s)
char *s;
{
syntax_error(line_num,col_num,s);
}
void
syntax_error(lineno,colno,s) /* Syntax error message */
unsigned lineno,colno;
char *s;
{
++error_count;
error_message(lineno,colno,s,"Error");
}
PRIVATE void
error_message(lineno,colno,s,tag)
unsigned lineno,colno;
char *s,*tag;
{
int icol;
extern unsigned prev_stmt_line_num; /* shared with advance.c */
/* Print the character ^ under the column number.
But if colno == 0, error occurred in prior line.
If colno is NO_COL_NUM, then print message
without any column number given.
*/
if(colno == NO_COL_NUM) {
/* colno == NO_COL_NUM means don't give column number.*/
(void)flush_line_out(lineno);/* print line if not printed yet */
fprintf(list_fd,
"\n%s near line %u",tag,lineno);
}
else if(colno != 0) {
/* print line if not printed yet */
if( flush_line_out(lineno) ) {
/* If it was printed, put ^ under the col */
fprintf(list_fd,"\n%8s","");
for(icol=1; icol<colno; icol++)
fprintf(list_fd," ");
fprintf(list_fd,"^");
}
fprintf(list_fd,
"\n%s near line %u col %u",tag,lineno,colno);
}
else { /* colno == 0 */
/* print line if not printed yet */
(void) flush_line_out(prev_stmt_line_num);
fprintf(list_fd,
"\n%s near line %u",tag,prev_stmt_line_num);
}
if(incdepth > 0) /* Append include-file name if we are in one */
fprintf(list_fd," file %s",current_filename);
fprintf(list_fd,": %s",s); /* now append the message string */
}
void
msg_tail(s)
char *s;
{
fprintf(list_fd," %s",s);
}
void
warning(lineno,colno,s) /* Print warning message */
unsigned lineno,colno;
char *s;
{
++warning_count;
error_message(lineno,colno,s,"Warning");
}
void
nonstandard(lineno,colno)
unsigned lineno,colno;
{
++warning_count;
error_message(lineno,colno,"Nonstandard syntax","Warning");
}
void
nonportable(lineno,colno,s) /* Print warning about nonportable construction */
unsigned lineno,colno;
char *s;
{
++warning_count;
error_message(lineno,colno,s,"Nonportable usage");
}
/* get_env_options picks up any options defined in the
environment. A switch or setting is defined according to
the value of an environment variable whose name is the switch
or setting name (uppercased), prefixed by the string
ENV_PREFIX (e.g. FORCHEK_). For settings and strsettings,
the value of the environment variable gives the value to be
used. For switches, the environment variable is set to "0" or
"NO" to turn the switch off, or to any other value (including
null) to turn it on.
*/
PRIVATE void
get_env_options()
{
char env_option_name[32];
char *value;
int i;
for(i=0; i<NUM_SWITCHES; i++) {
/* Construct the env variable name for switch i */
make_env_name( env_option_name, switchopt[i].name);
/* See if it is defined */
if( (value = getenv(env_option_name)) != (char *)NULL) {
*(switchopt[i].switchflag) =
!(strcmp(value,"0")==0 || strcmp(value,"NO")==0 );
}
}
for(i=0; i<NUM_SETTINGS; i++) {
/* Construct the env variable name for setting i */
make_env_name( env_option_name, setting[i].name);
/* See if it is defined */
if( (value = getenv(env_option_name)) != (char *)NULL) {
if(read_setting(value, setting[i].setvalue, setting[i].name,
setting[i].minlimit, setting[i].maxlimit) != 0)
fprintf(stderr,"Env setting garbled: %s=%s: ignored\n",
env_option_name,value);
}
}
for(i=0; i<NUM_STRSETTINGS; i++) {
/* Construct the env variable name for setting i */
make_env_name( env_option_name, strsetting[i].name);
/* See if it is defined */
if( (value = getenv(env_option_name)) != (char *)NULL) {
*(strsetting[i].strvalue) = value;
/* Handle necessary action for -out=listfile */
if(strsetting[i].strvalue == &out_fname)
must_open_outfile = TRUE;
}
}
}
/* Routine to concatenate ENV_PREFIX onto option name
and uppercase the result.
*/
PRIVATE void
make_env_name( env_name, option_name)
char *env_name, *option_name;
{
int i,c;
strcat(strcpy(env_name,ENV_PREFIX),option_name);
for(i=sizeof(ENV_PREFIX)-1; (c=env_name[i]) != '\0'; i++) {
if( islower(c) )
env_name[i] = toupper(c);
}
}
/* set_option processes an option from command line. Argument s is
the option string. First s is compared against boolean switches
from list in switchopt[]. If s matches switch string,
corresponding flag is set to TRUE. If no match, then s is compared
to the same switches prefixed by "no", and if match is found, then
flag is set to FALSE. Finally, special flags are handled. If still
no match, an error message is generated.
*/
PRIVATE void
set_option(s)
char *s;
{
int i;
for(i=0; i<NUM_SWITCHES; i++) {
if( strncmp(s+1,switchopt[i].name,OPT_MATCH_LEN) == 0) {
*(switchopt[i].switchflag) = TRUE;
return;
}
}
/* switch not found: look for noswitch flag */
if(strncmp(s+1,"no",2) == 0) {
for(i=0; i<NUM_SWITCHES; i++) {
if( strncmp(s+3,switchopt[i].name,OPT_MATCH_LEN) == 0) {
*(switchopt[i].switchflag) = FALSE;
return;
}
}
}
/* Handle settings of form "-opt=number" */
for(i=0; i<NUM_SETTINGS; i++)
if( strncmp(s+1,setting[i].name,OPT_MATCH_LEN) == 0) {
char *numstr;
numstr = s + (OPT_MATCH_LEN + 1);
while(*numstr != '\0')
if(*numstr++ == '=') /* Find the = sign */
break;
if(read_setting(numstr, setting[i].setvalue, setting[i].name,
setting[i].minlimit, setting[i].maxlimit) != 0)
fprintf(stderr,"Setting garbled: %s: ignored\n",s);
return;
}
/* Handle settings of form "-opt=string" */
for(i=0; i<NUM_STRSETTINGS; i++)
if( strncmp(s+1,strsetting[i].name,OPT_MATCH_LEN) == 0) {
char *strstart;
strstart = s + (OPT_MATCH_LEN + 1);
while(*strstart != '=' && *strstart != '\0')
strstart++; /* Find the = sign */
if(*strstart == '\0') {
fprintf(stderr,"String setting missing: %s: ignored\n",s);
return;
}
else {
*(strsetting[i].strvalue) = ++strstart;
}
/* Handle necessary action for -out=listfile */
if(strsetting[i].strvalue == &out_fname) {
must_open_outfile = TRUE;
}
return;
}
/* No match found: issue error message */
fprintf(stderr,"\nUnknown commandline switch: %s\n",s);
}
/* Routine to read integer setting from string s and check if valid */
PRIVATE int
read_setting(s, setvalue, name, minlimit, maxlimit)
char *s;
int *setvalue;
char *name;
int minlimit, maxlimit;
{
int given_val;
if(*s == '\0' || sscanf(s,"%d", &given_val) == 0) {
return -1; /* error return: garbled setting */
}
else { /* If outside limits, set to nearest limit */
int Ok=TRUE;
if(given_val < minlimit) {
given_val = minlimit;
Ok = FALSE;
}
else if(given_val > maxlimit) {
given_val = maxlimit;
Ok = FALSE;
}
if(! Ok ) {
fprintf(stderr,"\nSetting: %s",name);
fprintf(stderr," outside limits %d to %d",
minlimit,maxlimit);
fprintf(stderr,": set to %d\n",given_val);
}
*(setvalue) = given_val;
}
return 0;
}
PRIVATE void
open_outfile(s) /* open the output file for listing */
char *s;
{
char *fullname; /* given name plus extension */
FILE *fd;
must_open_outfile = FALSE; /* Turn off the flag */
if(s == (char *) NULL || *s == '\0') {
return; /* No filename: no action */
}
fullname = add_ext(s,DEF_LIST_EXTENSION);
if( (fd = fopen(fullname,"w")) == NULL) {
fprintf(stderr,"\nCannot open %s for output\n",fullname);
}
else {
fprintf(stderr,"\nOutput sent to file %s\n",fullname);
list_fd = fd;
}
}
PRIVATE void
list_options() /* List all commandline options, strsettings, and settings */
{
int i;
/* Note: Headings say "default" but to be accurate they
should say "current value". This would be confusing. */
fprintf(stderr,"\nCommandline options [default]:");
for(i=0; i<NUM_SWITCHES; i++) {
if( !debug_latest &&
strncmp(switchopt[i].explanation,"debug",5) == 0)
continue; /* skip debug switches unless debug mode */
fprintf(stderr,"\n\t%c[no]%s",OPT_PREFIX,switchopt[i].name);
fprintf(stderr," [%s]",*(switchopt[i].switchflag)? "yes": "no");
fprintf(stderr,": %s",switchopt[i].explanation);
}
/* String settings follow switches w/o their own heading */
for(i=0; i<NUM_STRSETTINGS; i++) {
if( !debug_latest &&
strncmp(strsetting[i].explanation,"debug",5) == 0)
continue; /* skip debug settings unless debug mode */
fprintf(stderr,"\n\t%c%s=str ",OPT_PREFIX,strsetting[i].name);
fprintf(stderr,"[%s]",
*(strsetting[i].strvalue)? *(strsetting[i].strvalue): "NONE");
fprintf(stderr,": %s",strsetting[i].explanation);
}
fprintf(stderr,"\nSettings (legal range) [default]:");
for(i=0; i<NUM_SETTINGS; i++) {
if( !debug_latest &&
strncmp(setting[i].explanation,"debug",5) == 0)
continue; /* skip debug settings unless debug mode */
fprintf(stderr,"\n\t%c%s=dd ",OPT_PREFIX,setting[i].name);
fprintf(stderr,"(%d to %d) ",setting[i].minlimit,
setting[i].maxlimit);
fprintf(stderr,"[%d]",*(setting[i].setvalue));
fprintf(stderr,": %s",setting[i].explanation);
}
fprintf(stderr,
"\n(First %d chars of option name significant)\n",OPT_MATCH_LEN);
}
PRIVATE void
wrapup() /* look at cross references, etc. */
{
check_comlists();
check_arglists();
}
/* Adds default extension to source file name if
none is present, and returns a pointer to the
new name. If extension was added, space is allocated
for the new name. If not, simply returns pointer
to original name.
*/
char *
add_ext(s,ext)
char *s,*ext;
{
int i,len=strlen(s);
char *newname;
/* Search backwards till find the dot, but do not
search past / (Unix) or ] (VMS) directory delimiter
*/
for(i=len; i>0; i--) {
if(s[i] == '.' || s[i] == '/' || s[i] == ']')
break;
}
if(s[i] != '.') {
newname = (char *) malloc( (unsigned)(len+strlen(ext)+1) );
(void)strcpy(newname,s);
(void)strcat(newname,ext);
s = newname;
}
return s;
}
/* Adds default extension to source file name, replacing
any that is present, and returns a pointer to the
new name. Space is allocated for the new name.
*/
char *
new_ext(s,ext)
char *s,*ext;
{
int i,len=strlen(s);
char *newname;
/* Search backwards till find the dot, but do not
search past / (Unix) or ] (VMS) directory delimiter
*/
for(i=len; i>0; i--) {
if(s[i] == '.' || s[i] == '/' || s[i] == ']')
break;
}
if(s[i] != '.') { /* No extension present: add one on */
newname = (char *) malloc( (unsigned)(len+strlen(ext)+1) );
(void)strcpy(newname,s);
(void)strcat(newname,ext);
}
else { /* Extension present: replace it */
newname = (char *) malloc( (unsigned)(i+strlen(ext)+1) );
(void)strncpy(newname,s,i);
(void)strcpy(newname+i,ext);
}
return newname;
}
PRIVATE int
cistrcmp(s1,s2) /* case-insensitive strcmp */
char *s1,*s2;
{
while( (isupper(*s1)?tolower(*s1):*s1) == (isupper(*s2)?tolower(*s2):*s2) ) {
if(*s1 == '\0')
return 0;
++s1; ++s2;
}
return *s1 - *s2;
}
int
has_extension(name,ext) /* true if name ends in ext */
char *name,*ext;
{
int stem_len = strlen(name) - strlen(ext);
if( stem_len >= 0 && cistrcmp(name+stem_len,ext) == 0 )
return TRUE;
else
return FALSE;
}
PRIVATE void
resource_summary()
{
fprintf(list_fd,
"\nMax namestring space used = %lu local, %lu global out of %lu chars",
max_loc_strings,
max_glob_strings,
(unsigned long)STRSPACESZ);
fprintf(list_fd,
"\nMax local symbols used = %lu out of %lu available",
max_loc_symtab,
(unsigned long)LOCSYMTABSZ);
fprintf(list_fd,
"\nMax global symbols used = %lu out of %lu available",
max_glob_symtab,
(unsigned long)GLOBSYMTABSZ);
fprintf(list_fd,
"\nMax tokenlist space used = %lu out of %lu available",
max_token_space,
(unsigned long)TOKENSPACESZ);
fprintf(list_fd,
"\nIdentifier hashtable size = %6lu",
(unsigned long)HASHSZ);
fprintf(list_fd,
"\nKeyword hashtable size = %6lu",
(unsigned long)KEYHASHSZ);
#ifdef COUNT_REHASHES
fprintf(list_fd,
"\nIdentifier rehash count = %6lu",
rehash_count);
#endif
fprintf(list_fd,
"\nIntrinsic function hashtable size=%6lu, clash count=%lu",
(unsigned long)INTRINS_HASHSZ,
intrins_clashes);
fprintf(list_fd,"\n\n");
}